home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / lspsql2.zip / DBVIEW.LSP < prev    next >
Encoding:
Text File  |  1992-12-13  |  8.7 KB  |  277 lines
  1. ;;;---------------------------------------------------------------------------
  2. ;;;
  3. ;;;   dbview.lsp
  4. ;;;   Copyright (C) 1991-1992 by Autodesk, Inc.
  5. ;;;      
  6. ;;;   Permission to use, copy, modify, and distribute this software 
  7. ;;;   for any purpose and without fee is hereby granted, provided 
  8. ;;;   that the above copyright notice appears in all copies and that 
  9. ;;;   both that copyright notice and this permission notice appear in 
  10. ;;;   all supporting documentation.
  11. ;;;
  12. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  13. ;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  14. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  15. ;;;   by Frumkin A.
  16. ;;;   April 20 1992
  17. ;;;
  18. ;;;--------------------------------------------------------------------------
  19. ;;;  DESCRIPTION
  20. ;;;
  21. ;;;  Test ASI. Allows customers to view and edit database tables.
  22. ;;;
  23. ;;;----------------------------------------------------------------------------
  24.  
  25. ;;;----------------------------------------------------------------------------
  26. ;;; Defined c: so that it can be used at the Command Line..
  27. ;;;----------------------------------------------------------------------------
  28.   (defun c:dbview()
  29.     (dbview)
  30.   )
  31.  
  32. ;;;
  33. ;;; Drive initialization.
  34. ;;;
  35.   (defun initdrv ( / drvname hdrv)
  36.       (setq drvname (getstring "\nEnter SQL driver name: "))
  37.       (if (not (= "" drvname))
  38.           (if (setq hdrv (asi_initdrv drvname))
  39.               (princ "\nDrive loaded")
  40.               (princ (strcat "\nCannot load " drvname))
  41.           )
  42.           (setq hdrv nil)
  43.       )
  44.       (setq hdrv hdrv)
  45.   )
  46.   
  47.   ;;;
  48.   ;;; Logon to the data base.
  49.   ;;;
  50.   (defun logon (hdrv / basename username password hcon)
  51.       (setq basename (getstring "\n\nDatabase name ->"))
  52.       (setq username (getstring "\nUser name ->"))
  53.       (setq password (getstring "\nPassword ->"))
  54.       (if (setq hcon (asi_lon hdrv basename username password))
  55.           (princ "OK")
  56.           (princ (strcat "\nCannot connect to database " basename))
  57.       )
  58.       (setq hcon hcon)
  59.   )
  60.   
  61.   ;;;
  62.   ;;; Fetching commands.
  63.   ;;;
  64.   (defun scan (hcom / flag com prev prompt)
  65.      (setq prev "Exit")
  66.      (while (not flag)
  67.         (print_row hcom)
  68.         (setq prompt
  69.                 (strcat "\nFirst/Last/Next/Previous/Delete/Update/Show/Exit/<"
  70.                         prev ">: "))
  71.         (initget 0 "First Last Next Previous Delete Update Show Exit")
  72.         (setq com (getkword prompt))
  73.         (if (= com nil)(setq com prev))
  74.         (cond 
  75.                 ((eq com "First")
  76.               (progn 
  77.                  (princ "\nTop")
  78.                  (asi_ftr hcom)
  79.               )
  80.           )
  81.                 ((eq com "Last")  
  82.               (progn 
  83.                  (princ "\nBottom")
  84.                  (asi_fbr hcom)
  85.               )
  86.           )
  87.                 ((eq com "Next")        (asi_fet hcom))
  88.                 ((eq com "Previous")   (asi_fbk hcom)) 
  89.                 ((eq com "Delete") 
  90.                         (if (asi_del hcom)      (princ "\nCurrent line deleted"))
  91.                 )
  92.                 ((eq com "Update")              (update_row hcom))
  93.                 ((eq com "Show")                (print_set hcom))
  94.                 ((eq com "Exit")                   (setq flag T))
  95.         )
  96.         (if (not (= com nil)) (setq prev com))
  97.      )
  98.   )
  99.   
  100.   ;;;
  101.   ;;; Prints row from database.
  102.   ;;;
  103.   (defun print_row (hcom)
  104.      (print_header hcom)
  105.      (if (= (fix (asi_currow hcom)) -2)
  106.         (princ "\nEOS")
  107.         (if (= (fix (asi_currow hcom)) -1) 
  108.            (princ "\nTOS")
  109.                 (print_data hcom)
  110.         )
  111.      )  
  112.   )
  113.   
  114.   ;;; 
  115.   ;;; Prints table.
  116.   ;;;
  117.   (defun print_set (hcom / rows flag)
  118.      (print_header hcom)
  119.      (setq rows 0)
  120.      (asi_ftr hcom)
  121.      (if (= (fix (asi_currow hcom)) -2)
  122.         (princ "\nEOS")
  123.         (if (= (fix (asi_currow hcom)) -1) 
  124.            (princ "\nTOS")
  125.                 (while (not flag)
  126.                         (print_data hcom)
  127.                         (setq rows (1+ rows))
  128.               (if (null (asi_fet hcom)) (setq flag T))
  129.                 )
  130.         )
  131.      )  
  132.      (asi_ftr hcom)
  133.      (princ (strcat "\n" (itoa rows) " rows selected"))
  134.      (getstring "\nPress RETURN...")
  135.   )
  136.   
  137.   ;;;
  138.   ;;; Prints names of columns.
  139.   ;;;
  140.   (defun print_header (hcom / str jj lst len l)
  141.      (setq str "\n    |" jj  0)
  142.      (while (setq lst (asi_cds hcom jj))
  143.          (setq jj (1+ jj))
  144.          (setq len (strlen (nth 0 lst)))
  145.          (if (< len (nth 1 lst)) (setq l (nth 1 lst)) (setq l len))
  146.            (setq str (strcat str (addlist (nth 0 lst) l) " | "))
  147.      )
  148.      (princ str)
  149.      (princ "\n    |--------------------")
  150.   )
  151.   
  152.   ;;;
  153.   ;;; Prints contents of table.
  154.   ;;;
  155.   (defun print_data (hcom / l lst len val jj tp str)
  156.       (setq str (strcat "\n" (addlist (itoa (+ 1 (fix (asi_currow hcom)))) 4) "|")
  157.             jj 0)
  158.       (while (setq val (asi_cvl hcom jj))
  159.           (setq lst (asi_cds hcom jj)
  160.                 tp (type val)
  161.                 len (strlen (nth 0 lst))
  162.           )
  163.           (if (< len (nth 1 lst)) (setq l (nth 1 lst)) (setq l len))
  164.         (cond 
  165.                     ((= tp 'INT)        
  166.                             (setq str 
  167.                                     (strcat str (addlist (itoa val) l) " | "))
  168.                     )
  169.                     ((= tp 'REAL) 
  170.                             (setq str 
  171.                                     (strcat str (addlist (rtos val 2 (nth 2 lst)) l) " | "))
  172.                     )
  173.                     (T (setq str (strcat str (addlist val l) " | ")))
  174.             )
  175.             (setq jj (1+ jj))
  176.       )
  177.       (princ str)
  178.       (terpri)
  179.   )
  180.   
  181.   ;;;
  182.   ;;; Adds spaces to string while its length leth then defined one.
  183.   ;;;
  184.   (defun addlist (str len / l)
  185.      (setq l (strlen str)) 
  186.      (while (< l len)
  187.         (setq l (1+ l) str (strcat str " "))
  188.      )
  189.      (setq str str)
  190.   )
  191.   
  192.   ;;;
  193.   ;;; Updates row.
  194.   ;;; 
  195.   (defun update_row (hcom / ii flag cds prompt val newval tp)
  196.      (if (>= (fix (asi_currow hcom)) 0 )
  197.         (progn
  198.            (princ "\n -------Update current row --------------\n")
  199.          (setq ii 0 flag T)
  200.          (while (and flag (setq cds (asi_cds hcom ii)))
  201.                  (setq val (asi_cvl hcom ii) 
  202.                       prompt (strcat "\n" (nth 0 cds) "<")
  203.                           tp (type val)
  204.                  )
  205.                  (cond 
  206.                     ((= tp 'INT)        
  207.                             (setq prompt (strcat prompt (itoa val) ">: "))
  208.                     )
  209.                     ((= tp 'REAL) 
  210.                             (setq prompt (strcat prompt (rtos val 2 (nth 2 cds)) ">: "))
  211.                     )
  212.                     (T 
  213.                             (setq prompt (strcat prompt val ">: "))
  214.                          )
  215.                  )
  216.            (setq newval (getstring prompt))
  217.                 (if (not (= newval ""))
  218.                   (if (= newval "NULL")  
  219.                      (setq flag (asi_upd hcom (nth 0 cds) ""))
  220.                      (setq flag (asi_upd hcom (nth 0 cds) newval))
  221.                   )) 
  222.              (if (not flag) (princ "  error") (setq ii (1+ ii)))
  223.          )
  224.         )
  225.      )
  226.   )
  227.   
  228.   ;;;
  229.   ;;; Error handle.
  230.   ;;;
  231.   (defun my_err (s)                  ; If an error (such as CTRL-C) occurs
  232.                                      ; while this command is active...
  233.   
  234.           (if hddrv (asi_termdrv hddrv))
  235.           (setq hddrv nil)
  236.           (if (/= (substr s 1 4) QUIT)
  237.              (princ s)
  238.           )
  239.           (setq *error* older)      ; restore old *error* handler
  240.           (prin1)
  241.   )
  242.   
  243.   ;;;
  244.   ;;; External command
  245.   ;;;
  246.   (defun dbview ( / hdcon hdcom)
  247.       (if asi_initdrv
  248.           (progn    
  249.               (setq olderr *error* *error* my_err)
  250.               (if (and 
  251.                       (setq hddrv (initdrv))
  252.                       (setq hdcon (logon hddrv))
  253.                       (setq hdcom (asi_ohdl hdcon))
  254.                       (not (= "" (setq name (getstring "\nTable name: "))))
  255.                   )
  256.                   (if (asi_cex hdcom (strcat "select * from " name))
  257.                       (scan hdcom)
  258.                       (princ (strcat "\nTable " name " not found."))
  259.                   )
  260.               )
  261.               (if hddrv (asi_termdrv hddrv))
  262.               (setq *error* older)      ; restore old *error* handler
  263.           )
  264.           (princ "\nLoad 'LISPSQL.EXP' before execution.")      
  265.       )
  266.       (prin1)
  267.   )
  268. ;;;----------------------------------------------------------------------------
  269.  
  270. (princ "C:DBVIEW loaded. Start command with (DBVIEW) or DBVIEW.")
  271. (princ)
  272.   
  273.   
  274.   
  275.   
  276.  
  277.